home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / hailpath.rpl < prev    next >
Text File  |  1991-02-21  |  2KB  |  49 lines
  1. HailPath
  2. By Joseph K. Horn
  3.  
  4. Returns the Syracuse Algorithm "hailstone path distance" between X and 1.
  5.  
  6. D9D20    @ :: (Begin RPL)    ; 02D9D Program object prolog (backwards!)
  7. E1632    @ \<<            ; 2361E Open program delimiters.
  8. B9691    @ R->B            ; 1969B Hex for double precision.
  9. CCD20    @   In-line code    ; 02DCC Code object prolog.
  10. F6000    @     Code length = 111    ; 0006F (Nib count includes itself.)
  11. AF9    @     C=B W        ; Save B
  12. 10A    @     R2=C        ;   in R2,
  13. 137    @     CD1EX        ;   and save D1 (user stack pointer)
  14. 109    @     R1=C        ;   in R1.
  15. 137    @     CD1EX        ; Get address
  16. 147    @     C=DAT1 A        ;   of level 1, and
  17. 137    @     CD1EX        ;   point to it.
  18. 179    @     D1=D1+ 10        ; Skip over object header to the contents.
  19. 1537    @     A=DAT1 W        ; Get level 1 argument (in hex) into A.
  20. 822    @     SB=0        ; Clear Sticky Bit, used for even/odd test.
  21. AF1    @     B=0 W        ; Clear the Loop Counter (B).
  22. AF3    @     D=0 W        ; The exit test needs a 1; make D=1 by
  23. B67    @     D=D+1 B        ;   clearing D and adding 1 to it.
  24. AF6    @ L1  C=A W        ; A,C hold the hailstone number en route to 1.
  25. 9FB    @     ?C<=D W        ; Has the hailstone hit ground yet? (is C<=1?) 
  26. F1    @     GOYES L3        ;   If so, exit; else,
  27. B75    @ L2  B=B+1 W        ;   increment the Loop Counter.
  28. 81C    @     ASRB        ; A=IP(A/2), and lost bit -> Sticky Bit.
  29. 832    @     ?SB=0        ; Was the hailstone number even?
  30. FE    @     GOYES L1        ;   If so, simply repeat; else,
  31. A72    @     C=C+A W        ; Multiply by 3, add 1, and divide by 2,
  32. B76    @     C=C+1 W        ;   using shortcut A+IP(A/2)+1.
  33. B75    @     B=B+1 W        ; Increment Loop Counter again due to shortcut.
  34. AFA    @     A=C W         ; Get ready for
  35. 822    @     SB=0        ;   the next test, and
  36. 55E    @     GONC L2        ;   go try again (Branch Every Time).
  37. AF9    @ L3  C=B W        ; Replace level 1 argument
  38. 1557    @     DAT1=C W        ;   with Loop Counter = HAILPATH(x).
  39. 119    @     C=R1        ; Restore User Stack Pointer (D1)
  40. 137    @     CD1EX        ;   from R1,
  41. 11A    @     C=R2        ;   and restore B
  42. AF5    @     B=C W        ;   from R2.
  43. 142    @     A=DAT0 A        ; End       \
  44. 164    @     D0=D0+ 5        ;   of       > Code always ends like this.
  45. 808C    @     PC=(A)        ;     Code. /
  46. BB691    @   B->R        ; 196BB Back to normal (decimal).
  47. 93632    @ \>>            ; 23639
  48. B2130    @ ; (End of RPL.)    ; 0312B
  49.